home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
476-500
/
disk_499
/
diglib
/
diglib.lzh
/
compiled000
/
MAPIT.for
Wrap
Text File
|
1991-04-23
|
8KB
|
270 lines
SUBROUTINE MAPIT(XLOW,XHIGH,YLOW,YHIGH,XLAB,YLAB,TITLE,IAXES)
IMPLICIT NONE
INCLUDE DIGLIB$KOM:PLTCOM.PRM
INCLUDE DIGLIB$KOM:PLTSIZ.PRM
INCLUDE DIGLIB$KOM:PLTCLP.PRM
INCLUDE DIGLIB$KOM:PLTPRM.PRM
INCLUDE DIGLIB$KOM:GCLTYP.PRM
C
EXTERNAL LEN
CHARACTER*1 XLAB(2), YLAB(2), TITLE(2)
CHARACTER*1 NUMBR(14)
LOGICAL*1 LOGXX, LOGYY, LOGT, LRMTEX, LSHORT, LRAGGD, IAND
REAL*4 ZLOG(8),TMINLD,SHORTF,XTMIN,XTMAX,XTICK,YTMIN,YTMAX
REAL*4 YTICK,VX,VY,TEMP,TENEXP,X,Y,TCKSGN,TICKSP,LN
INTEGER NUMTK,IXPWR,IYPWR,MXLAB,N,J,ILABSZ
C
DATA ZLOG /0.3010, 0.4771, 0.6021, 0.6990, 0.7782, 0.8451,
1 0.9031, 0.9542 /
C MINIMUM DISTANCE BETWEEN SHORT TICKS (1 MM)
DATA TMINLD /0.1/
C SHORT TICKS = TICKLN/SHORTF
DATA SHORTF /2.0/
C
C SET LOGX AND LOGY TO FALSE FOR OUR USAGE OF SCALE
C
LOGX = .FALSE.
LOGY = .FALSE.
C
C SEE WHAT TYPE OF AXES ARE DESIRED
C
LOGXX = IAND(IAXES,1) .NE. 0
LOGYY = IAND(IAXES,2) .NE. 0
LRAGGD = IAND(IAXES,256) .NE. 0
C
C DO THE AXES SCALING
C
NUMTK = MIN0(10,INT(XVLEN/((ILABSZ()+1.0)*CXSIZE)))
IF (LOGXX) GO TO 20
LSHORT = IAND(IAXES,16) .NE. 0
CALL AXIS(XLOW,XHIGH,NUMTK,LSHORT,LRAGGD,XMIN,XMAX,XTMIN,XTMAX,
1 XTICK,IXPWR)
GO TO 40
20 CALL LAXIS(XLOW,XHIGH,NUMTK,XMIN,XMAX,XTICK)
XTMIN = XMIN
XTMAX = XMAX
IXPWR = 0
40 NUMTK = MIN0(10,INT(YVLEN/(3.0*CYSIZE)))
IF (LOGYY) GO TO 60
LSHORT = IAND(IAXES,32) .NE. 0
CALL AXIS(YLOW,YHIGH,NUMTK,LSHORT,LRAGGD,YMIN,YMAX,YTMIN,YTMAX,
1 YTICK,IYPWR)
GO TO 80
60 CALL LAXIS(YLOW,YHIGH,NUMTK,YMIN,YMAX,YTICK)
YTMIN = YMIN
YTMAX = YMAX
IYPWR = 0
80 CONTINUE
C
C SET UP SCALING FACTORS FOR SCALE
C
UX0 = XMIN
UDX = XMAX - XMIN
UY0 = YMIN
UDY = YMAX - YMIN
C
C ********** DRAW Y AXES **********
C
CALL GSSETC(CYSIZE,0.0)
LOGT = .FALSE.
IF (.NOT. LOGYY .OR. YTICK .NE. 1.0) GO TO 90
CALL SCALE(XMIN,YMIN,VX,TEMP)
CALL SCALE(XMIN,YMIN+1.0-ZLOG(8),VX,VY)
IF ((VY-TEMP) .GE. TMINLD) LOGT = .TRUE.
90 CONTINUE
C
C DRAW Y AXIS LINE
C
MXLAB = 3
TENEXP = 10.0**IYPWR
X = XMIN
C TICK SPACING
TICKSP = AMAX1(0.0,TICKLN)
IF (IAND(IAXES,64) .NE. 0) YVLEN = YVLEN - TICKSP
C TICKS TO LEFT FOR LEFT Y AXIS
TCKSGN = -TICKLN
100 CONTINUE
CALL SCALE(X,YMAX,VX,VY)
CALL GSMOVE(VX,VY)
CALL SCALE(X,YMIN,VX,VY)
CALL GSDRAW(VX,VY)
C
C DRAW AND LABEL Y AXIS TICKS
C
Y = YTMIN
N = (YTMAX-YTMIN)/YTICK + 1.1
110 CONTINUE
CALL SCALE(X,Y*TENEXP,VX,VY)
CALL GSMOVE(VX,VY)
CALL GSDRAW(VX+TCKSGN,VY)
IF (X .EQ. XMAX) GO TO 185
IF (IAND(IAXES,1024) .NE. 0) GO TO 183
C
C PLACE THE APPROPIATE LABEL
C
IF (LOGYY) GO TO 160
CALL LINLAB(INT(Y),IYPWR,NUMBR,LRMTEX)
GO TO 180
160 CALL LOGLAB(INT(Y),NUMBR)
180 LN = LEN(NUMBR)
MXLAB = MAX0(MXLAB,LN)
CALL GSMOVE(VX-TICKSP-CXSIZE*(LN+0.25),VY-CYSIZE/2.0)
CALL GSPSTR(NUMBR)
C
C ADD GRID LINE AT TICK IF DESIRED
C
183 CONTINUE
IF (IAND(IAXES,8) .EQ. 0) GO TO 185
CALL GSLTYP(3)
CALL GSMOVE(VX,VY)
CALL SCALE(XMAX,Y*TENEXP,VX,VY)
CALL GSDRAW(VX,VY)
CALL GSLTYP(1)
185 CONTINUE
C
C DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
C
IF ((.NOT. LOGT) .OR. (Y .EQ. YTMAX)) GO TO 200
DO 190 J = 1, 8
CALL SCALE(X,Y+ZLOG(J),VX,VY)
CALL GSMOVE(VX,VY)
190 CALL GSDRAW(VX+TCKSGN/SHORTF,VY)
200 CONTINUE
Y = Y + YTICK
N = N-1
IF (N .GT. 0) GO TO 110
IF (X .EQ. XMAX) GO TO 300
C
C IF LINEAR AXIS, PLACE REMOTE EXPONENT IF NEEDED
C
IF (LOGYY .OR. (.NOT. LRMTEX)) GO TO 260
IF (IAND(IAXES,1024) .NE. 0) GO TO 260
CALL SCALE(XMIN,(YTMIN+YTICK/2.0)*TENEXP,VX,VY)
CALL SCOPY('E'//CHAR(0),NUMBR)
CALL NUMSTR(IYPWR,NUMBR(2))
CALL GSMOVE(VX-CXSIZE*(LEN(NUMBR)+0.5),VY-CYSIZE/2.0)
CALL GSPSTR(NUMBR)
C
C NOW PLACE Y LABLE
C
260 CALL SCALE(XMIN,(YMIN+YMAX)/2.0,VX,VY)
CALL GSMOVE(VX-(MXLAB+0.25)*CXSIZE-TICKSP-CYSIZE,
1 VY-CXSIZE*LEN(YLAB)/2.0)
CALL GSSETC(CYSIZE,90.0)
CALL GSPSTR(YLAB)
CALL GSSETC(CYSIZE,0.0)
IF (IAND(IAXES,128) .EQ. 0) GO TO 300
X = XMAX
TCKSGN = TICKLN
GO TO 100
300 CONTINUE
C
C ********** DRAW X AXIS **********
C
LOGT = .FALSE.
IF (.NOT. LOGXX .OR. XTICK .NE. 1.0) GO TO 310
CALL SCALE(XMIN,YMIN,TEMP,VY)
CALL SCALE(XMIN+1.0-ZLOG(8),YMIN,VX,VY)
IF ((VX-TEMP) .GE. TMINLD) LOGT = .TRUE.
310 CONTINUE
C
C DRAW X AXIS LINE
C
Y = YMIN
TCKSGN = -TICKLN
TENEXP = 10.0**IXPWR
C TICK SPACING
TICKSP = AMAX1(0.5*CYSIZE,TICKLN)
320 CONTINUE
CALL SCALE(XMIN,Y,VX,VY)
CALL GSMOVE(VX,VY)
CALL SCALE(XMAX,Y,VX,VY)
CALL GSDRAW(VX,VY)
C
C DRAW AND LABEL X AXIS TICKS
C
X = XTMIN
N = (XTMAX-XTMIN)/XTICK + 1.1
400 CONTINUE
CALL SCALE(X*TENEXP,Y,VX,VY)
CALL GSMOVE(VX,VY)
CALL GSDRAW(VX,VY+TCKSGN)
IF (Y .EQ. YMAX) GO TO 430
IF (IAND(IAXES,512) .NE. 0) GO TO 423
IF (LOGXX) GO TO 410
CALL LINLAB(INT(X),IXPWR,NUMBR,LRMTEX)
GO TO 420
410 CALL LOGLAB(INT(X),NUMBR)
420 CALL GSMOVE(VX-CXSIZE*LEN(NUMBR)/2.0,VY-TICKSP-1.5*CYSIZE)
CALL GSPSTR(NUMBR)
C
C ADD GRID LINE AT TICK IF DESIRED
C
423 CONTINUE
IF (IAND(IAXES,4) .EQ. 0) GO TO 430
CALL GSLTYP(3)
CALL GSMOVE(VX,VY)
CALL SCALE(X*TENEXP,YMAX,VX,VY)
CALL GSDRAW(VX,VY)
CALL GSLTYP(1)
430 CONTINUE
C
C DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
C
IF ((.NOT. LOGT) .OR. (X .EQ. XTMAX)) GO TO 490
DO 450 J = 1, 8
CALL SCALE(X+ZLOG(J),Y,VX,VY)
CALL GSMOVE(VX,VY)
CALL GSDRAW(VX,VY+TCKSGN/SHORTF)
450 CONTINUE
490 CONTINUE
X = X + XTICK
N = N-1
IF (N .GT. 0) GO TO 400
IF (Y .EQ. YMAX) GO TO 590
C
C NOW PLACE REMOTE EXPONENT IF NEEDED ON LINEAR AXIS
C
IF (LOGXX .OR. (.NOT. LRMTEX)) GO TO 520
IF (IAND(IAXES,512) .NE. 0) GO TO 520
CALL SCALE(XMIN,YMIN,VX,VY)
CALL SCOPY('E'//CHAR(0),NUMBR)
CALL NUMSTR(IXPWR,NUMBR(2))
CALL GSMOVE(VX+3*CXSIZE,VY-TICKSP-2.75*CYSIZE)
CALL GSPSTR(NUMBR)
C
C NOW PLACE X AXIS LABLE
C
520 CALL SCALE((XMIN+XMAX)/2.0,YMIN,VX,VY)
CALL GSMOVE(VX-CXSIZE*LEN(XLAB)/2.0,VY-TICKSP-4.0*CYSIZE)
CALL GSPSTR(XLAB)
IF (IAND(IAXES,64) .EQ. 0) GO TO 590
Y = YMAX
TCKSGN = TICKLN
GO TO 320
590 CONTINUE
C
C ********** PLACE TITLE **********
C
CALL SCALE((XMIN+XMAX)/2.0,YMAX,VX,VY)
TCKSGN = 0.0
IF (IAND(IAXES,64) .NE. 0) TCKSGN = TICKSP
CALL GSMOVE(VX-CXSIZE*LEN(TITLE)/2.0,VY+TCKSGN+CYSIZE)
CALL GSPSTR(TITLE)
C
C MAKE SURE "PLTCLP" CONTAINS LIMITS PICKED BY MAPIT. ONLY MAINTAINED
C FOR CALLERS INFO.
C
IF (.NOT. LOGXX) GO TO 610
XMIN = 10.0**XMIN
XMAX = 10.0**XMAX
LOGX = .TRUE.
610 CONTINUE
IF (.NOT. LOGYY) GO TO 620
YMIN = 10.0**YMIN
YMAX = 10.0**YMAX
LOGY = .TRUE.
620 CONTINUE
RETURN
END